Info-Mac 4/Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso/Development/Source/DBL Pascal Library/HashTables ƒ/HashTables.p

Text File | 1993-10-25 | 27KB | 783 lines

unit HashTables;

{Copyright © 1993 David B. Lamkins. All rights reserved worldwide.}
{}
{This implementation of hash tables uses three handles: one for the table, one for the}
{buckets, and one for all the keys and values. None of these handles are locked except}
{during operations which call user-provided functions for hashing and matching keys.}
{}
{Nominal overhead is 50 bytes plus 4 bytes per slot for the table, 12 bytes for each}
{bucket, and the Memory Manager overhead for three relocatable blocks. Actual overhead}
{will be higher due to preallocation of space to store buckets and data.}
{}
{The buckets area is preallocatated to hold as many entries as there are slots. Deleted}
{buckets are returned to a free list for reuse. Each time all free buckets are used up, the}
{area is expanded to hold about half as many extra buckets as there are slots in the table.}
{The data area is also preallocated at a reasonable size, depending upon the number of slots}
{and the expected average size of entries. When the data area fills up, it is extended by}
{a reasonable amount to allow room for extra entries. This strategy of allocating extra}
{space for data and bucket areas minimizes the heap thrashing that might otherwise}
{occur if an area was expanded only to hold the next entry.}
{}
{Values are stored in-place in the data area. Replacing a value with one of a different size}
{is equivalent to deleting the old entry then adding a new one. This is very fast, but it has}
{an impact on the space used for key/value storage — see below. You can avoid the deletion}
{overhead by replacing an existing value with a new value of identical size.}
{}
{Deletion of an entry leaves unused gaps which must be compacted out of the data area if}
{their total size becomes excessive.}
{}
{Compaction is an expensive operation taking time proportional to the amount of space used}
{by all the keys and values, but is more efficient than the multiple block moves that would}
{be needed to remove the space unused by deleted entries when done one at a time.}

interface

    type
        HashTable = Handle;

    const    {Some handy prime numbers to use for table sizes.}
        kPrime67 = 67;
        kPrime139 = 139;
        kPrime281 = 281;
        kPrime563 = 563;
        kPrime1129 = 1129;
        kPrime2267 = 2267;

{Create a new hash table. You can pass nil for the hash and match functions to use defaults.}
{If you pass 0 for the average entry size, you’ll get a default data area and expansion size.}
{The number of slots should be prime, since most hashing functions work best with a prime}
{modulus. If you have a hashing function that doesn’t expect a prime modulus, you can set}
{the number of slots as required.}
    function NewHashTable (numSlots: Integer; {normally a prime number!}
                                    averageEntrySize: Integer; {}
                                    HashFuncPtr: ProcPtr; {function HashFunc(keyData: Ptr; keyLength, modulus: Integer): Integer;}
                                    MatchFuncPtr: ProcPtr; {function MatchFunc(keyData: Ptr; keyLength: Integer; entryData: Ptr; entryLength: Integer): Boolean;}
                                    var theTable: HashTable): OSErr;

{Get rid of a hash table and all its associated storage.}
    function DisposeHashTable (theTable: HashTable): OSErr;

{Remove all the entries from the given table. Time is proportional to number of entries.}
    function EmptyHashTable (theTable: HashTable): OSErr;

{Add a key/value pair to the table, or replace the existing value if the key is already present.}
{This is optimized for speed in the case where the old and new values are the same size.}
    function SetHashEntry (theTable: HashTable; keyPtr: Ptr; keyLength: Integer; valuePtr: Ptr; valueLength: Integer; var replaced: Boolean): OSErr;

{Given a key, return the offset and length of the associated data within the dataBlock.}
    function GetHashEntry (theTable: HashTable; keyPtr: Ptr; keyLength: Integer; var valueOffset: Longint; var valueLength: Integer; var dataBlock: Handle; var found: Boolean): OSErr;

{Given a key, remove its entry. This can be expensive in terms of time.}
    function RemoveHashEntry (theTable: HashTable; keyPtr: Ptr; keyLength: Integer; var found: Boolean): OSErr;

{Return the number of entries in the table. This is a constant-time operation.}
    function CountHashEntries (theTable: HashTable; var count: Longint): OSErr;

{Enumerate all the key/value pairs in the given hash table.}
{Start with state = 0. Caller must preserve state across calls.}
{When state becomes 0 after call, current results are to be ignored — there’s no more.}
{When state is nonzero after call, an entry is described by its offsets and lengths relative}
{to the start of the dataBlock. If you add or delete an entry when state <> 0, you’ll get}
{a paramErr result on the next call and state will be reset to zero.}
    function GetNextHashEntry (theTable: HashTable; var keyOffset: Longint; var keyLength: Integer; var valueOffset: Longint; var valueLength: Integer; var dataBlock: Handle; var state: Longint): OSErr;

{The efficiency of the table is defined as the number of chains divided by the number of}
{buckets. With no collisions, the efficiency is 1. As the length of chains increases, the}
{efficiency decreases below 1. By definition, an empty table has an efficiency of 1.}
{This is a constant-time operation.}
    function HashEfficiency (theTable: HashTable; var efficiency: Real): OSErr;

{The occupancy of the table is defined as the number of chains divided by the number of}
{available slots. An empty table has an occupancy of 0. When all the slots have been filled,}
{occupancy becomes 1. Due to collisions, it’s possible to have more entries than slots}
{and still not have an occupancy of 1. This is a constant-time operation.}
    function HashSlotOccupancy (theTable: HashTable; var occupancy: Real): OSErr;

{Return the number of slots allocated to this table at creation or rehash time.}
    function HashTableSlotCount (theTable: HashTable; var numSlots: Integer): OSErr;

{Change the number of slots in the table. Time is proportional to number of entries.}
    function ReHash (theTable: HashTable; numSlots: Integer): OSErr;

{Find out how much memory we would get back by calling CompactHashDataSpace.}
    function HashRecoverableSpace (theTable: HashTable; var recoverableSpace: Size): OSErr;

{Remove gaps from the data area. Time is proportional to total size active keys and values.}
{This temporarily uses additional space equal to the active data, plus an expansion reserve.}
{This returns paramErr if called when HashRecoverableSpace is zero.}
    function CompactHashSpace (theTable: HashTable): OSErr;

implementation

    type
        TableEntryOffset = Longint;
        TableEntry = record
                keyOff: Longint;
                keyLen: Integer;
                valLen: Integer;    {No offset for value; it follows key.}
                nextOffset: TableEntryOffset;    {Relative to beginning of block.}
            end;
        TableEntryPtr = ^TableEntry;
        Table = record
                dataHandle: Handle;
                dataLimit: Longint;
                expandAmount: Size;
                bucketsHandle: Handle;
                freeBucketOffset: Longint;
                maxBuckets: Longint;
                maxIndex: Integer;
                hashFunc: ProcPtr;
                matchFunc: ProcPtr;
                iteratorSlot: Integer;
                iteratorBucket: TableEntryOffset;
                iteratorCheckCount: Longint;
                bucketCount: Longint;
                usedSlotCount: Integer;
                totalGapSpace: Size;
                slots: array[0..0] of TableEntryOffset;
            end;
        TablePtr = ^Table;
        TableHandle = ^TablePtr;

    const
        EndOfList = -1;    {In-list offsets are >= 0.}

    function DefaultHashFunction (keyData: Ptr; keyLength, modulus: Integer): Integer;
        var
            hashResult: Longint;
            p: Ptr;
            i: Integer;
    begin
        hashResult := 0;
        p := keyData;
        for i := 1 to keyLength do
            begin
                hashResult := BROTR(BXOR(hashResult, p^), 5);
                p := Ptr(ORD(p) + SIZEOF(SignedByte));
            end;
        if hashResult < 0 then    {We need a positive result.}
            hashResult := BNOT(hashResult);    {Rather than negation, because --MAXLONGINT = -MAXLONGINT.}
        DefaultHashFunction := hashResult mod modulus;
    end; {DefaultHashFunction}

    function DefaultMatchFunction (keyData: Ptr; keyLength: Integer; entryData: Ptr; entryLength: Integer): Boolean;
    begin
        DefaultMatchFunction := IUMagIDString(keyData, entryData, keyLength, entryLength) = 0;
    end; {DefaultMatchFunction}

    procedure InternalLinkFreeBuckets (theTable: TableHandle; firstOffset: Longint);
        var
            i, nextOffset: Longint;
            bucketPtr: TableEntryPtr;
    begin
        with theTable^^ do
            begin
                bucketPtr := TableEntryPtr(ORD(bucketsHandle^) + firstOffset);
                nextOffset := firstOffset + SIZEOF(TableEntry);
                for i := (firstOffset div SIZEOF(TableEntry)) + 1 to maxBuckets - 1 do
                    begin
                        bucketPtr^.nextOffset := nextOffset;
                        nextOffset := nextOffset + SIZEOF(TableEntry);
                        bucketPtr := TableEntryPtr(ORD(bucketPtr) + SIZEOF(TableEntry));
                    end;
        {Tack the old free list onto the end.}
                bucketPtr^.nextOffset := freeBucketOffset;
        {Put the new buckets at the head of the free list.}
                freeBucketOffset := firstOffset;
            end;
    end; {InternalLinkFreeBuckets}

    procedure InternalInitSlots (theTable: TableHandle);
        var
            entry: Integer;
    begin
        with TableHandle(theTable)^^ do
            begin
                for entry := 0 to maxIndex do
                    begin
{$PUSH}
{$R-}
                        slots[entry] := EndOfList;
{$POP}
                    end;
                usedSlotCount := 0;
            end;
    end; {InternalInitSlots}

    function NewHashTable (numSlots: Integer; averageEntrySize: Integer; HashFuncPtr: ProcPtr; MatchFuncPtr: ProcPtr; var theTable: HashTable): OSErr;

        procedure CheckMemErr;
            var
                err: OSErr;
        begin
            err := MemError;
            if err <> noErr then
                begin
                    NewHashTable := err;
                    Exit(NewHashTable);
                end;
        end; {CheckMemErr}

        const
            MinDataBlockSize = 1024;
        var
            initialSize: Size;
            dataBlock: Handle;
            buckets: Handle;
            bucketPtr: TableEntryPtr;
    begin
        theTable := HashTable(NewHandleClear(SIZEOF(Table) + (numSlots - 1) * SIZEOF(TableEntryOffset)));
        CheckMemErr;
        initialSize := averageEntrySize * numSlots;
        if initialSize <= 0 then
            initialSize := MinDataBlockSize;
        dataBlock := NewHandle(initialSize);
        CheckMemErr;
        buckets := NewHandle(numSlots * SIZEOF(TableEntry));
        CheckMemErr;
        with TableHandle(theTable)^^ do
            begin
                dataHandle := dataBlock;
                totalGapSpace := 0;
                expandAmount := initialSize div 2;
                maxIndex := numSlots - 1;
                InternalInitSlots(TableHandle(theTable));
                bucketsHandle := buckets;
                freeBucketOffset := EndOfList;    {None, yet.}
                maxBuckets := numSlots;
                InternalLinkFreeBuckets(TableHandle(theTable), 0);
                if HashFuncPtr = nil then
                    hashFunc := @DefaultHashFunction
                else
                    hashFunc := HashFuncPtr;
                if matchFuncPtr = nil then
                    matchFunc := @DefaultMatchFunction
                else
                    matchFunc := MatchFuncPtr;
            end;
        NewHashTable := noErr;
    end; {NewHashTable}

    function EmptyHashTable (theTable: HashTable): OSErr;
        var
            entry: Integer;
    begin
        HLock(Handle(theTable));
        with TableHandle(theTable)^^ do
            begin
                InternalInitSlots(TableHandle(theTable));
                bucketCount := 0;
                dataLimit := 0;
                SetHandleSize(dataHandle, expandAmount * 2);
                maxBuckets := maxIndex + 1;
                SetHandleSize(bucketsHandle, maxBuckets * SIZEOF(TableEntry));
                freeBucketOffset := EndOfList;
                InternalLinkFreeBuckets(TableHandle(theTable), 0);
            end;
        HUnlock(Handle(theTable));
        EmptyHashTable := noErr;
    end; {EmptyHashTable}

    function DisposeHashTable (theTable: HashTable): OSErr;
        var
            err: OSErr;
    begin
    {Dispose all the buckets.}
        DisposeHandle(TableHandle(theTable)^^.bucketsHandle);
    {Dispose the dataBlock.}
        DisposeHandle(TableHandle(theTable)^^.dataHandle);
    {Now dispose the table itself.}
        DisposeHandle(Handle(theTable));
        DisposeHashTable := noErr;
    end; {DisposeHashTable}

    function CallHashFunc (KeyData: Ptr; keyLength, tableMaxIndex: Integer; theCode: ProcPtr): Integer;
    inline
        $205F,            {movea.l (sp)+,a0}
        $4E90;            {jsr (a0)}

    function CallMatchFunc (keyData: Ptr; keyLength: Integer; entryData: Ptr; entryLength: Integer; theCode: ProcPtr): Boolean;
    inline
        $205F,            {movea.l (sp)+,a0}
        $4E90;            {jsr (a0)}

{Just like GetHashEntry, except hashKey and bucket are always returned.}
    function InternalGetHashEntry (theTable: HashTable; dataBlock: Handle; keyPtr: Ptr; keyLength: Integer; var valueOffset: Longint; var valueLength: Integer; var hashKey: Integer; var bucket: TableEntryOffset): Boolean;
        var
            bucketPtr: TableEntryPtr;
    begin
        HLock(theTable);
        HLock(dataBlock);
        with TableHandle(theTable)^^ do
            begin
                hashKey := CallHashFunc(keyPtr, keyLength, maxIndex + 1, hashFunc);
{$PUSH}
{$R-}
                bucket := slots[hashKey];
{$POP}
                while bucket <> EndOfList do
                    begin
                        bucketPtr := TableEntryPtr(ORD(bucketsHandle^) + bucket);
                        with bucketPtr^ do
                            if CallMatchFunc(keyPtr, keyLength, Ptr(ORD(dataBlock^) + keyOff), keyLen, matchFunc) then
                                Leave
                            else
                                bucket := nextOffset;
                    end;
                if bucket <> EndOfList then
                    with bucketPtr^ do
                        begin
                            valueOffset := keyOff + keyLen;
                            valueLength := valLen;
                            InternalGetHashEntry := True;
                        end
                else
                    InternalGetHashEntry := False;
            end;
        HUnlock(dataBlock);
        HUnlock(theTable);
    end; {InternalGetHashEntry}

    function InternalNewBucket (theTable: TableHandle; hashKey: Integer; keyOffset: Longint; keyLength, valueLength: Integer; var bucket: TableEntryOffset): OSErr;

        procedure CheckMemErr;
            var
                err: OSErr;
        begin
            err := MemError;
            if err <> noErr then
                begin
                    InternalNewBucket := err;
                    Exit(InternalNewBucket);
                end;
        end; {CheckMemErr}

        var
            bucketPtr: TableEntryPtr;
            buckets: Handle;
            oldBucketsSize: Size;
            oldMaxBuckets: Longint;
            bucketsExpansionCount: Integer;

    begin {InternalNewBucket}
        if theTable^^.freeBucketOffset = EndOfList then
            begin
                with theTable^^ do
                    begin
                        buckets := bucketsHandle;
                        bucketsExpansionCount := maxIndex div 2;
                    end;
                oldBucketsSize := GetHandleSize(buckets);
                SetHandleSize(buckets, oldBucketsSize + bucketsExpansionCount * SIZEOF(TableEntry));
                CheckMemErr;
                with theTable^^ do
                    begin
                        oldMaxBuckets := maxBuckets;
                        maxBuckets := maxBuckets + bucketsExpansionCount;
                    end;
                InternalLinkFreeBuckets(theTable, oldMaxBuckets * SIZEOF(TableEntry));
            end;
        with theTable^^ do
            begin
                bucket := freeBucketOffset;
                bucketPtr := TableEntryPtr(ORD(bucketsHandle^) + bucket);
                freeBucketOffset := bucketPtr^.nextOffset;
                bucketCount := bucketCount + 1;
{$PUSH}
{$R-}
                if slots[hashKey] = EndOfList then
                    usedSlotCount := usedSlotCount + 1;
                bucketPtr^.nextOffset := slots[hashKey];
                slots[hashKey] := bucket;
{$POP}
            end;
        with bucketPtr^ do
            begin
                keyOff := keyOffset;
                keyLen := keyLength;
                valLen := valueLength;
            end;
        InternalNewBucket := noErr;
    end; {InternalNewBucket}

    function SetHashEntry (theTable: HashTable; keyPtr: Ptr; keyLength: Integer; valuePtr: Ptr; valueLength: Integer; var replaced: Boolean): OSErr;

        procedure CheckMemErr;
            var
                err: OSErr;
        begin
            err := MemError;
            if err <> noErr then
                begin
                    SetHashEntry := err;
                    Exit(SetHashEntry);
                end;
        end; {CheckMemErr}

        var
            dataBlock: Handle;
            newEntryOffset: Longint;

        procedure AllocateNewData;
            var
                oldBlockSize, newBlockSize: Size;
                newDataLimit: Longint;
        begin
    {If there’s not enough room at the end of the dataBlock to hold}
    {key and value, expand the block by the minimum of the expansion}
    {amount or the total size of the key and value plus the expansion amount.}
            oldBlockSize := GetHandleSize(dataBlock);
            CheckMemErr;
            with TableHandle(theTable)^^ do
                begin
                    newEntryOffset := dataLimit;
                    newDataLimit := dataLimit + keyLength + valueLength;
                    if newDataLimit > oldBlockSize then
                        begin
                            if newDataLimit > oldBlockSize + expandAmount then
                                newBlockSize := newDataLimit + expandAmount
                            else
                                newBlockSize := oldBlockSize + expandAmount;
                            SetHandleSize(dataBlock, newBlockSize);
                            CheckMemErr;
                        end;
                end;
            with TableHandle(theTable)^^ do
                dataLimit := newDataLimit;
    {Put the new key and value into the dataBlock.}
            with TableHandle(theTable)^^ do
                begin
                    BlockMove(keyPtr, Ptr(ORD(dataBlock^) + newEntryOffset), keyLength);
                    BlockMove(valuePtr, Ptr(ORD(dataBlock^) + newEntryOffset + keyLength), valueLength);
                end;
        end; {AllocateNewData}

        var
            hashKey: Integer;
            oldVOff: Longint;
            oldVLen: Integer;
            bucket: TableEntryOffset;
            bucketPtr: TableEntryPtr;

    begin {SetHashEntry}
        dataBlock := TableHandle(theTable)^^.dataHandle;
        if InternalGetHashEntry(theTable, dataBlock, keyPtr, keyLength, oldVOff, oldVLen, hashKey, bucket) then
            begin
        {There’a an old entry with this key.}
                replaced := True;
                if oldVLen <> valueLength then
                    begin
            {The new value is a different length than the old. Key and value get moved to the}
            {end of the data area, leaving a gap. Then we update the key’s existing bucket.}
                        with TableHandle(theTable)^^ do
                            totalGapSpace := totalGapSpace + keyLength + oldVLen;
                        AllocateNewData;
                        with TableHandle(theTable)^^, TableEntryPtr(ORD(bucketsHandle^) + bucket)^ do
                            begin
                                keyOff := newEntryOffset;
                                valLen := valueLength;
                            end;
                    end
                else
                    begin
            {The new value overlays the old value of the same length.}
                        BlockMove(valuePtr, Ptr(ORD(dataBlock^) + oldVOff), oldVLen);
                    end;
            end
        else
            begin
        {This is the first time we’ve seen this key. Store key and value in the data area}
        {and give them a new bucket.}
                replaced := False;
                AllocateNewData;
                SetHashEntry := InternalNewBucket(TableHandle(theTable), hashKey, newEntryOffset, keyLength, valueLength, bucket);
            end;
        SetHashEntry := noErr;
    end; {SetHashEntry}

    function RemoveHashEntry (theTable: HashTable; keyPtr: Ptr; keyLength: Integer; var found: Boolean): OSErr;
        var
            dataBlock: Handle;
            hashKey: Integer;
            bucket: TableEntryOffset;
            bucketPtr, chainFollower: TableEntryPtr;
            existingValueOffset: Longint;
            existingValueLength: Integer;
            ignoreLong: Longint;
    begin
        dataBlock := TableHandle(theTable)^^.dataHandle;
        if InternalGetHashEntry(theTable, dataBlock, keyPtr, keyLength, existingValueOffset, existingValueLength, hashKey, bucket) then
            with TableHandle(theTable)^^ do
                begin
        {Unlink the bucket.}
                    bucketPtr := TableEntryPtr(ORD(bucketsHandle^) + bucket);
                    bucketCount := bucketCount - 1;
{$PUSH}
{$R-}
                    chainFollower := TableEntryPtr(ORD(bucketsHandle^) + slots[hashKey]);
{$POP}
                    if chainFollower = bucketPtr then {Delete first bucket.}
                        begin
                            if bucketPtr^.nextOffset = EndOfList then
                                usedSlotCount := usedSlotCount - 1;
{$PUSH}
{$R-}
                            slots[hashKey] := bucketPtr^.nextOffset;
{$POP}
                        end
                    else
                        begin
                            while chainFollower^.nextOffset <> bucket do
                                chainFollower := TableEntryPtr(ORD(bucketsHandle^) + chainFollower^.nextOffset);
                            chainFollower^.nextOffset := bucketPtr^.nextOffset;
                        end;
            {Account for the unused space.}
                    with bucketPtr^ do
                        totalGapSpace := totalGapSpace + keyLen + valLen;
        {Link the disposed bucket onto the free list.}
                    bucketPtr^.nextOffset := freeBucketOffset;
                    freeBucketOffset := bucket;
                    found := True;
                end
        else
            found := False;
        RemoveHashEntry := noErr;
    end; {RemoveHashEntry}

    function GetHashEntry (theTable: HashTable; keyPtr: Ptr; keyLength: Integer; var valueOffset: Longint; var valueLength: Integer; var dataBlock: Handle; var found: Boolean): OSErr;
        var
            hashKey: Integer;
            bucket: TableEntryOffset;
    begin
        dataBlock := TableHandle(theTable)^^.dataHandle;
        found := InternalGetHashEntry(theTable, dataBlock, keyPtr, keyLength, valueOffset, valueLength, hashKey, bucket);
        GetHashEntry := noErr;
    end; {GetHashEntry}

    function CountHashEntries (theTable: HashTable; var count: Longint): OSErr;
    begin
        count := TableHandle(theTable)^^.bucketCount;
        CountHashEntries := noErr;
    end; {CountHashEntries}

    procedure InternalAdvanceIterator (theTable: TableHandle; firstTime: Boolean);
    begin
        with theTable^^ do
            begin
                if firstTime then
                    begin
                        iteratorBucket := EndOfList;    {Start at the beginning.}
                        iteratorSlot := -1;
                        iteratorCheckCount := bucketCount;
                    end;
                while (iteratorBucket = EndOfList) and (iteratorSlot < maxIndex) do
                    begin
                        iteratorSlot := iteratorSlot + 1;
{$PUSH}
{$R-}
                        iteratorBucket := slots[iteratorSlot];
{$POP}
                    end;
            end;
    end; {InternalAdvanceIterator}

    function GetNextHashEntry (theTable: HashTable; var keyOffset: Longint; var keyLength: Integer; var valueOffset: Longint; var valueLength: Integer; var dataBlock: Handle; var state: Longint): OSErr;
        var
            bucketPtr: TableEntryPtr;
    begin
        with TableHandle(theTable)^^ do
            if (state <> 0) and (bucketCount <> iteratorCheckCount) then
                begin
                    GetNextHashEntry := paramErr;
                    state := 0;
                    Exit(GetNextHashEntry);
                end;
        InternalAdvanceIterator(TableHandle(theTable), state = 0);
        with TableHandle(theTable)^^ do
            if iteratorBucket <> EndOfList then
                begin
                    bucketPtr := TableEntryPtr(ORD(bucketsHandle^) + iteratorBucket);
                    with bucketPtr^ do
                        begin
                            keyOffset := keyOff;
                            keyLength := keyLen;
                            valueOffset := keyOff + keyLen;
                            valueLength := valLen;
                        end;
                    state := state + 1;
                    iteratorBucket := bucketPtr^.nextOffset;
                end
            else
                state := 0;    {No more.}
        dataBlock := TableHandle(theTable)^^.dataHandle;
        GetNextHashEntry := noErr;
    end; {GetNextHashEntry}

    function HashEfficiency (theTable: HashTable; var efficiency: Real): OSErr;
    begin
        with TableHandle(theTable)^^ do
            if bucketCount > 0 then
                efficiency := usedSlotCount / bucketCount
            else
                efficiency := 1.0;
        HashEfficiency := noErr;
    end; {HashEfficiency}

    function HashSlotOccupancy (theTable: HashTable; var occupancy: Real): OSErr;
    begin
        with TableHandle(theTable)^^ do
            occupancy := usedSlotCount / (maxIndex + 1);
        HashSlotOccupancy := noErr;
    end; {HashSlotOccupancy}

    function HashTableSlotCount (theTable: HashTable; var numSlots: Integer): OSErr;
    begin
        with TableHandle(theTable)^^ do
            numSlots := maxIndex + 1;
        HashTableSlotCount := noErr;
    end; {HashTableSlotCount}

    function ReHash (theTable: HashTable; numSlots: Integer): OSErr;

        procedure CheckMemErr;
            var
                err: OSErr;
        begin
            err := MemError;
            if err <> noErr then
                begin
                    ReHash := err;
                    Exit(ReHash);
                end;
        end; {CheckMemErr}

        var
            rehashChain, chainTemp: TableEntryOffset;
            rehashChainPtr: TableEntryPtr;
            slotIndex: Integer;

    begin {ReHash}
    {Collect all the entries into one long chain.}
        rehashChain := EndOfList;
        InternalAdvanceIterator(TableHandle(theTable), True);
        with TableHandle(theTable)^^ do
            begin
                repeat
                    if iteratorBucket <> EndOfList then
                        begin
                            chainTemp := rehashChain;
                            rehashChain := iteratorBucket;
                            rehashChainPtr := TableEntryPtr(ORD(bucketsHandle^) + iteratorBucket);
                            iteratorBucket := TableEntryPtr(ORD(bucketsHandle^) + iteratorBucket)^.nextOffset;
                            rehashChainPtr^.nextOffset := chainTemp;
                        end;
                    InternalAdvanceIterator(TableHandle(theTable), False);
                until iteratorBucket = EndOfList;
            end;
    {Resize the table.}
        with TableHandle(theTable)^^ do
            begin
                maxIndex := numSlots - 1;
                SetHandleSize(theTable, SIZEOF(Table) + maxIndex * SIZEOF(TableEntryOffset));
                CheckMemErr;
            end;
    {Clear the slots.}
        InternalInitSlots(TableHandle(theTable));
    {Rehash each entry and chain it into its new slot, and update occupancy info.}
        HLock(theTable);
        with TableHandle(theTable)^^ do
            begin
                HLock(dataHandle);
                HLock(bucketsHandle);
                rehashChainPtr := TableEntryPtr(ORD(bucketsHandle^) + rehashChain);
                while rehashChain <> EndOfList do
                    begin
                        with rehashChainPtr^ do
                            slotIndex := CallHashFunc(Ptr(ORD(dataHandle^) + keyOff), keyLen, numSlots, hashFunc);
                        chainTemp := rehashChainPtr^.nextOffset;
{$PUSH}
{$R-}
                        if slots[slotIndex] = EndOfList then
                            usedSlotCount := usedSlotCount + 1;
                        rehashChainPtr^.nextOffset := slots[slotIndex];
                        slots[slotIndex] := rehashChain;
{$POP}
                        rehashChain := chainTemp;
                        rehashChainPtr := TableEntryPtr(ORD(bucketsHandle^) + rehashChain);
                    end;
                HUnlock(bucketsHandle);
                HUnlock(dataHandle);
            end;
        HUnlock(theTable);
        ReHash := noErr;
    end; {ReHash}

    function HashRecoverableSpace (theTable: HashTable; var recoverableSpace: Size): OSErr;
    begin
        with TableHandle(theTable)^^ do
            begin
                recoverableSpace := GetHandleSize(dataHandle) - ((dataLimit - totalGapSpace) + expandAmount);
                if recoverableSpace <= expandAmount then
                    recoverableSpace := 0;
            end;
        HashRecoverableSpace := noErr;
    end; {HashRecoverableSpace}

    function CompactHashSpace (theTable: HashTable): OSErr;

        procedure CheckErr (err: OSErr);
        begin
            if err <> noErr then
                begin
                    CompactHashSpace := err;
                    Exit(CompactHashSpace);
                end;
        end; {CheckErr}

        var
            ignoreErr: OSErr;
            recoverableSpace: Size;
            newSize: Size;
            newDataBlock: Handle;
            newDataLimit: Longint;
            entrySize: Size;

    begin {CompactHashSpace}
    {Bail out if it’s not worth the effort.}
        ignoreErr := HashRecoverableSpace(theTable, recoverableSpace);
        if recoverableSpace = 0 then
            CheckErr(paramErr);
    {Create a new data area of the requisite size.}
        with TableHandle(theTable)^^ do
            newSize := dataLimit - totalGapSpace + expandAmount;
        newDataBlock := NewHandle(newSize);
        CheckErr(MemError);
    {Copy each live entry from the old area to the new, then set its bucket to the copied data.}
        newDataLimit := 0;
        InternalAdvanceIterator(TableHandle(theTable), True);
        with TableHandle(theTable)^^ do
            repeat
                if iteratorBucket <> EndOfList then
                    with TableEntryPtr(ORD(bucketsHandle^) + iteratorBucket)^ do
                        begin
                            entrySize := keyLen + valLen;
                            BlockMove(Ptr(ORD(dataHandle^) + keyOff), Ptr(ORD(newDataBlock^) + newDataLimit), entrySize);
                            keyOff := newDataLimit;
                            newDataLimit := newDataLimit + entrySize;
                            iteratorBucket := nextOffset;
                        end;
                InternalAdvanceIterator(TableHandle(theTable), False);
            until iteratorBucket = EndOfList;
    {Get rid of the old data area and install the new, then update housekeeping info.}
        DisposeHandle(TableHandle(theTable)^^.dataHandle);
        with TableHandle(theTable)^^ do
            begin
                dataHandle := newDataBlock;
                dataLimit := newDataLimit;
                totalGapSpace := 0;
            end;
        CompactHashSpace := noErr;
    end; {CompactHashSpace}

end.